00100	BEGIN	"LAMPS AD HOC"
00200		REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300		REQUIRE "TRIGER[SYS,BGB]" SOURCE_FILE;
00400		DEFINE RA="201.94";
00500		DEFINE RB="239.51";
00600		DEFINE RC="274.18";
00700	
00800		PRELOAD_WITH
00900		437,	438,	439,
01000		437,	438,	440,
01100		436.25,	437.5,	438.5,
01200		428,	428,	0,
01300		426,	426,	0,
01400		420,	418.5,	416.5;
01500		REAL ARRAY ZZ[1:6,1:3];
01600	
01700		REAL ARRAY QQ[1:6,1:3];
01800	
01900		INTEGER I,J,FLG;
     

00100	α DMS converts from degrees, minutes and seconds to radians;
00200	α The argument is in decimal positions DDDMMSS ← ((d*100+m)*100+s;
00300	
00400	REAL PROCEDURE DMS (INTEGER X);
00500	BEGIN	"DMS"
00600		INTEGER D,M,S,Y;
00700		REAL Z;
00800		Y	←	ABS(X);
00900		S	←	Y MOD 100;
01000		Y	←	Y DIV 100;
01100		M	←	Y MOD 100;
01200		D	←	Y DIV 100;
01300		Z	←	D*1745.32925@-5 + M*2908.8821@-7 + S*4848.1368@-9;
01400		IF X<0 THEN Z←-Z;
01500		RETURN(Z);
01600	END	"DMS";
01700	
01800		QQ[1,1]	←	-DMS(125000);
01900		QQ[1,2]	←	-DMS(125000);
02000		QQ[1,3]	←	-DMS(133000);
02100	
02200		QQ[2,1]	←	-DMS(471000);
02300		QQ[2,2]	←	-DMS(471000);
02400		QQ[2,3]	←	-DMS(463000);
02500	
02600		QQ[3,1]	←	-DMS(545000);
02700		QQ[3,2]	←	-DMS(545000);
02800		QQ[3,3]	←	-DMS(553000);
02900	
03000		QQ[4,1]	←	π + DMS(883000);
03100		QQ[4,2]	←	π + DMS(883000);
03200		QQ[4,3]	←	π + DMS(883000);
03300	
03400		QQ[5,1]	←	π + DMS(805000);
03500		QQ[5,2]	←	π + DMS(805000);
03600		QQ[5,3]	←	π + DMS(805000);
03700	
03800		QQ[6,1]	←	π + DMS(415000);
03900		QQ[6,2]	←	π + DMS(415000);
04000		QQ[6,3]	←	π + DMS(423000);
     

00100		OPEN(1,"DSK",0,0,3,0,0,0);
00200		ENTER(1,"LAMPS.FEA",FLG);
00300		FOR I←1 STEP 1 UNTIL 6 DO
00400		FOR J←1 STEP 1 UNTIL 3 DO
00500	BEGIN
00600		REAL R,X,Y,Z;
00700		OUT(1,"LMP");
00800		OUT(1,CVS(I));
00900		OUT(1,CASE J OF("","A","B","C"));
01000		OUT(1,"L   ");
01100		R ← CASE J OF (0,RA,RB,RC);
01200		X ← COS(QQ[I,J])*R;
01300		Y ← SIN(QQ[I,J])*R;
01400		Z ← ZZ[I,J] + 21/12;
01500		OUT(1,CVF(X));OUT(1,"   ");
01600		OUT(1,CVF(Y));OUT(1,"   ");
01700		OUT(1,CVF(Z));OUT(1,"   ");
01800		OUT(1,"0.0  0.0");
01900		OUT(1,↓);
02000	
02100		Z ← Z+14;
02200		OUT(1,"LMP");
02300		OUT(1,CVS(I));
02400		OUT(1,CASE J OF("","A","B","C"));
02500		OUT(1,"H   ");
02600		OUT(1,CVF(X));OUT(1,"   ");
02700		OUT(1,CVF(Y));OUT(1,"   ");
02800		OUT(1,CVF(Z));OUT(1,"   ");
02900		OUT(1,"0.0  0.0");
03000		OUT(1,↓);
03100	END;
03200		RELEASE(1);
03300	END	"LAMPS AD HOC";